with Legend.Roles.Specials;
with Ada.Exceptions;
with Legend.Traces;
with Legend.Stages.Rooms, Legend.Stages.WarFields;
with Legend.Resources;
with Legend.Dialogs;
with Legend.Renders;
with Legend.StrRes;
with Legend.Story_Engine;
with Legend.Music;
with Legend.Timers;
with Legend.Hero_State_Dialog;
with SDL.Keyboard, SDL.RWops;
with Ada.Strings; use Ada.Strings;
with Ada.Strings.Unbounded;
with Ada.Strings.Fixed;
with Text_Builder;
package body Legend.Stages is

   Show_Building_Grids : Boolean := False;



   -- 转换地图坐标到视觉坐标
   procedure Map_To_View (
      this : Stage_Type;
      M    : Point_Type;
      V    : out Point_Type
      )
   is
   begin
      -- 设gw,gh为地表贴图像素宽高, 则
      -- 当在地图上东走一步时, 在投影地图上的x增加gw/2, y增加gh/2
      -- 当在地图上南走一步时, 在投影地图上的x减少gw/2, y增加gh/2
      -- 当在地图上西走一步时, 在投影地图上的x减少gw/2, y减少gh/2
      -- 当在地图上北走一步时, 在投影地图上的x增加gw/2, y减少gh/2
      -- 由于地图上任一点(mx, my)都在原点的东南方, 因此我们很容易得到如下算式:
      V.x := this.Origin.x + M.x - M.y;
      V.y := this.Origin.y + M.y + M.x;
   end Map_To_View;

   -- 转换视觉坐标到地图坐标
   procedure View_To_Map (
      this : Stage_Type;
      V    : Point_Type;
      M    : out Point_Type
      )
   is
   begin
      M.x := (V.x + V.y - (this.Origin.x + this.Origin.y)) / 2;
      M.y := (V.y - V.x - (this.Origin.y - this.Origin.x)) / 2;
   end View_To_Map;

   -- 转换视觉坐标到画布坐标
   procedure View_To_Canvas (
      this : Stage_Type;
      V    : Point_Type;
      C    : out Point_Type
      )
   is
   begin
      c.x := (V.x - this.Sight_View.Top_Left.x) * this.Grid_Size.x;
      c.y := (V.y - this.Sight_View.Top_Left.y) * this.Grid_Size.y;
   end View_To_Canvas;

   -- 转换视觉区域到地图区域
   procedure View_Region_To_Map_Region (
      this : Stage_Type;
      V    : Region_Type;
      M    : out View_Corners_Type
      )
   is
   begin
      this.View_To_Map((V.Bottom_Right.x, V.Top_Left.y), M.TR);
      this.View_To_Map((V.Top_Left.x, V.Bottom_Right.y), M.BL);
      this.View_To_Map(V.Top_Left, M.TL);
      this.View_To_Map(V.Bottom_Right, M.BR);
   end View_Region_To_Map_Region;

   -- 转换地图区域到视觉区域
   procedure Map_Region_To_View_Region (
      this : Stage_Type;
      M    : Region_Type;
      V    : out Region_Type
      )
   is
   begin
      this.Map_To_View(M.Top_Left, V.Top_Left);
      this.Map_To_View(M.Bottom_Right, V.Bottom_Right);
   end Map_Region_To_View_Region;

   -- 检查指定位置是否在地图范围之内
   function Is_In_Map (
      this : Stage_Type;
      M    : Point_Type
      ) return Boolean
   is
      map_size : Point_Type renames this.Map_Size;
   begin
      return M.x in 0 .. map_size.x - 1 and M.y in 0 .. map_size.y - 1;
   end Is_In_Map;

   function Is_In_Sight (
      this : Stage_Type;
      M    : Point_Type
      ) return Boolean
   is
      v : Point_Type;
      tl : Point_Type renames this.Sight_View.Top_Left;
      br : Point_Type renames this.Sight_View.Bottom_Right;
   begin
      this.Map_To_View(M, v);
      return (v.x in tl.x .. br.x) and (v.y in tl.y .. br.y);
   end Is_In_Sight;

   -- 获取画布中心的地图坐标
   function Get_Canvas_Center_As_Map (
      this : Stage_Type
      ) return Point_Type
   is
      tl : Point_Type renames this.Sight_View.Top_Left;
      br : Point_Type renames this.Sight_View.Bottom_Right;
      v : Point_Type := tl + br;
      m : Point_Type;
   begin
      v.x := (v.x + 1) / 2;
      v.y := (v.y + 1) / 2;
      this.View_To_Map(v, m);
      return m;
   end Get_Canvas_Center_As_Map;

   -- 磁撞检测
   -- 本函数不对m作边界检测, 因此如有必要请在调用前进行边界检测
   function Has_Obstacle_At (
      this  : Stage_Type;
      M     : Point_Type;
      Horse : Horse_Type
      ) return Boolean
   is
   begin
      if this.Stories /= null then
         declare
            id : Uint16_t := this.Get(ml_Story, M);
         begin
            if id in this.Stories'Range then
               if this.Stories(id).Visible = Yes then
                  return True;
               end if;
            end if;
         end;
      end if;
      if this.Hit_Surface then
         if this.Get(ml_Surface, M) /= 0 then
            return True;
         end if;
      else
         declare
            b : Point_Type := Get_Building_Location(this, M);
         begin
            if In_Region(b, this.Get_Map_Region) then
               if b /= (0, 0) and then this.Get(ml_Building, b) /= 0 then
                  return True;
               end if;
            end if;
         end;
      end if;
      -- water
      if not Water_Obstacle then
         return False;
      end if;
      if In_Groups(this.Get(ml_Earth, M) / 2, Resources.World_Waters) then
         return Horse /= Boat;
      else
         return Horse = Boat;
      end if;
   end Has_Obstacle_At;

   -- 设置指定地图位置建筑物贴图编号
   procedure Set_Building_At (
      this : in out Stage_Type;
      M    : Point_Type;
      B    : Uint16_t
      )
   is
   begin
      this.Set(ml_Building, M, B * 2);
      if not this.Hit_Surface then
         this.Set(ml_BX, M, (if B /= 0 then To_Uint16(M.x) else 0));
         this.Set(ml_BY, M, (if B /= 0 then To_Uint16(M.y) else 0));
      end if;
   end Set_Building_At;

   procedure Set_Movie_Flag (
      Resource_Id : in out Uint16_t;
      Has_Movie   : Boolean
      )
   is
      pragma Inline(Set_Movie_Flag);
   begin
      if Has_Movie then
         Resource_Id := Resource_Id or 1;
      else
         Resource_Id := Resource_Id and 2#1111_1111_1111_1110#;
      end if;
   end Set_Movie_Flag;

   procedure Set_Movie_At (
      this    : in out Stage_Type;
      Where   : Point_Type;
      Movie   : Movie_Type;
      Layer   : Map_Layer_Type;
      Expired : Duration := Loop_Infinite;
      Replace : Boolean := True
      )
   is
      map : Layer_Access := this.Layers(Layer);
      c   : Movie_Grid_Lists.Cursor := Movie_Grid_Lists.No_Element;
   begin
      for i in this.Movies.Iterate loop
         if Is_Same_Location(this.Movies(i), Layer, Where) then
            c := i;
            exit;
         end if;
      end loop;
      if Movie_Grid_Lists.Has_Element(c) then
         if not Replace then
            return;
         end if;
         Timers.World_Clock.Delete_Timer(this.Movies(c).Movie.Timer);
         this.Movies.Replace_Element(c, (Where, Layer, Movie));
      else
         this.Movies.Append((Where, Layer, Movie));
         c := this.Movies.Last;
      end if;
      Set_Movie_Flag(map(Where.y, Where.x), Has_Movie => True);
      if not this.Hit_Surface and Layer = ml_Building then
         this.Set(ml_BX, Where, Uint16_t(Where.x));
         this.Set(ml_BY, Where, Uint16_t(Where.y));
      end if;
      if Movie.Total > 1 then
         Interactives.Start_Play_Movie(this.Movies(c).Movie, Expired);
      end if;
      if this.Is_In_Sight(Where) then
         this.Canvas.Invalidate;
      end if;
   end Set_Movie_At;

   procedure Move_Movie (
      this  : in out Stage_Type;
      Layer : Map_Layer_Type;
      From  : Point_Type;
      To    : Point_Type
      )
   is
      map : Layer_Access := this.Layers(Layer);
      c   : Movie_Grid_Lists.Cursor := Movie_Grid_Lists.No_Element;
   begin
      for i in this.Movies.Iterate loop
         if Is_Same_Location(this.Movies(i), Layer, From) then
            c := i;
            exit;
         end if;
      end loop;
      if Movie_Grid_Lists.Has_Element(c) then
         Set_Movie_Flag(map(From.y, From.x), Has_Movie => False);
         this.Movies(c).Where := To;
         Set_Movie_Flag(map(To.y, To.x), Has_Movie => True);
         if not this.Hit_Surface and Layer = ml_Building then
            if map(From.y, From.x) = 0 then
               this.Set(ml_BX, From, 0);
               this.Set(ml_BY, From, 0);
            end if;
            if map(To.y, To.x) = 1 then
               this.Set(ml_BX, To, Uint16_t(To.x));
               this.Set(ml_BY, To, Uint16_t(To.y));
            end if;
         end if;
         if this.Is_In_Sight(From) then
            this.Canvas.Invalidate;
         end if;
      end if;
   end Move_Movie;

   procedure Remove_Movie_At (
      this  : in out Stage_Type;
      Layer : Map_Layer_Type;
      Where : Point_Type
      )
   is
      map : Layer_Access := this.Layers(Layer);
      c   : Movie_Grid_Lists.Cursor := Movie_Grid_Lists.No_Element;
   begin
      for i in this.Movies.Iterate loop
         if Is_Same_Location(this.Movies(i), Layer, Where) then
            c := i;
            exit;
         end if;
      end loop;
      if Movie_Grid_Lists.Has_Element(c) then
         Timers.World_Clock.Delete_Timer(this.Movies(c).Movie.Timer);
         this.Movies.Delete(c);
         Set_Movie_Flag(map(Where.y, Where.x), Has_Movie => False);
         if not this.Hit_Surface and Layer = ml_Building then
            if map(Where.y, Where.x) = 0 then
               this.Set(ml_BX, Where, 0);
               this.Set(ml_BY, Where, 0);
            end if;
         end if;
         if this.Is_In_Sight(Where) then
            this.Canvas.Invalidate;
         end if;
      end if;
   end Remove_Movie_At;

   procedure Set (
      this  : in out Stage_Type;
      Layer : Map_Layer_Type;
      Where : Point_Type;
      Value : Uint16_t
      )
   is
      map : Layer_Access := this.Layers(Layer);
   begin
      if map = null then
         return;
      end if;
      if In_Bound(map, Where) then
         map(Where.y, Where.x) := Value;
         this.Canvas.Invalidate;
      end if;
   end Set;

   function Get (
      this  : Stage_Type;
      Layer : Map_Layer_Type;
      Where : Point_Type
      ) return Uint16_t
   is
      pragma Inline(Get);
   begin
      return this.Layers(Layer)(Where.y, Where.x);
   end Get;

   function Sprite_layer (this : Stage_Type) return Map_Layer_Type
   is
   begin
      return (if this.Hit_Surface then ml_Surface else ml_Building);
   end Sprite_Layer;

   procedure Replace_Map (
      this  : in out Stage_Type;
      Layer : Map_Layer_Type;
      From  : Uint16_t;
      To    : Uint16_t
      )
   is
   begin
      for v of this.Layers(Layer).all loop
         if v = From then
            v := To;
         end if;
      end loop;
      this.Canvas.Invalidate;
   end Replace_Map;

   -- 根据建筑区域的任一点获取建筑物的东南角坐标
   function Get_Building_Location (
      this : Stage_Type;
      M    : Point_Type
      ) return Point_Type
   is
   begin
      if this.Hit_Surface then
         return M;
      else
         return (To_Int16(this.Get(ml_BX, M)), To_Int16(this.Get(ml_BY, M)));
      end if;
   end Get_Building_Location;

   -- 获取建筑物的西北角坐标
   function Get_West_North (
      this       : Stage_Type;
      East_South : Point_Type
      ) return Point_Type
   is
      west_north : Point_Type := East_South;
   begin
      for y in reverse 0 .. East_South.y loop
         exit when To_Int16(this.Get(ml_BY, (East_South.x, y))) /= East_South.y;
         west_north.y := y;
      end loop;
      for x in reverse 0 .. East_South.x loop
         exit when To_Int16(this.Get(ml_BX, (x, East_South.y))) /= East_South.x;
         west_north.x := x;
      end loop;
      return west_north;
   end Get_West_North;

   function Get_Pictures (
      this : in out Stage_Type
      ) return Pictures_Pointer
   is
      pragma Inline (Get_Pictures);
   begin
      return this.Pictures;
   end Get_Pictures;

   function Is_Same_Location (
      Grid  : Movie_Grid_Type; 
      Layer : Map_Layer_Type;
      Where : Point_Type
      ) return Boolean
   is
   begin
      return Grid.Where = Where and Grid.Layer = Layer;
   end Is_Same_Location;

   procedure Draw_Grid (
      this  : in out Stage_Type;
      Layer : Map_Layer_Type;
      Where : Point_Type 
      )
   is
      map : Layer_Access := this.Layers(Layer);
      picture_index : Uint16_t := map(Where.y, Where.x);
      id : Uint16_t;
      v, c : Point_Type;
      pictures : Pictures_Pointer := this.Pictures;
   begin
      -- check if m is movie grid first
      -- FIXME
      -- hero position not overlap building position
      -- so hero is not shown
      if picture_index mod 2 = 1 then
         for g of this.Movies loop
            if Is_Same_Location(g, Layer, Where) then
               picture_index := (g.Movie.First + Uint16_t(g.Movie.Index)) * 2;
               pictures := g.Movie.Pictures;
               exit;
            end if;
         end loop;
      end if;
      if picture_index not in 0 | No_Picture then
         id := picture_index / 2;
         if id in pictures'Range then
            this.Map_To_View(Where, v);
            this.View_To_Canvas(v, c);
            if this.Hit_Surface and Layer = ml_Building then
               c := c - (
                  Int16_t(this.Get(ml_BX, Where)),
                  Int16_t(this.Get(ml_BY, Where)));
            end if;
            this.Canvas.Draw_Picture(pictures(id), c);
         end if;
      end if;
   end Draw_Grid;

   -- 景深比较
   function More_Near (A, B : Scenery_Type) return Boolean
   is
      m1 : Point_Type := A.West_North + A.Location; -- / 2
      m2 : Point_Type := B.West_North + B.Location; -- / 2
      ay : Int16_t := m1.x + m1.y;                  -- logic map y to screen y
      by : Int16_t := m2.x + m2.y;                  -- logic map y to screen y
   begin
      if ay = by then
         return A.Layer > B.Layer;
      else
         return ay > by;
      end if;
   end More_Near;

   package Scenery_Sorting is
      new Scenery_Lists.Generic_Sorting(More_Near);

   procedure Iterate_Layer (
      this : in out Stage_Type;
      Layer : Layer_Access;
      Corners : View_Corners_Type;
      On_Iterate_Grid : not null access procedure (Where : Point_Type)
      )
   is
      bound : Line_Bound_Type := (Corners.TR.x, Corners.TR.x + 1);
      delta_west : Int16_t := -1;
      delta_east : Int16_t := 1;
   begin
      -- 从北到南依次绘制各行的贴图
      for my in Corners.TR.Y .. Corners.BL.y loop
         if my in Layer'Range(1) then
            for mx in bound.West .. bound.East loop
               if mx in Layer'Range(2) then
                  On_Iterate_Grid((mx, my));
               end if;
            end loop;
         end if;
         -- 调整下一行的东西边界
         bound.West := bound.West + (if my < Corners.TL.y then -1 else 1);
         bound.East := bound.East + (if my < Corners.BR.y then 1 else -1);
      end loop;
   end Iterate_Layer;

   procedure Paint_Background (
      this : in out Stage_Type;
      Corners : View_Corners_Type
      )
   is
      map : Layer_Access := this.Layers(ml_Earth);
      procedure Draw_Background_Grid (Where : Point_Type)
      is
      begin
         this.Draw_Grid(ml_Earth, Where);
      end Draw_Background_Grid;
   begin
      if this.Visibles(ml_Earth) then
         this.Iterate_Layer(map, Corners, Draw_Background_Grid'Access);
      end if;
   end Paint_Background;

   procedure Paint_Surface (
      this : in out Stage_Type;
      Corners : View_Corners_Type
      )
   is
      map : Layer_Access := this.Layers(ml_Surface);
      procedure Draw_Surface_Grid (Where : Point_Type)
      is
         pic_id : Uint16_t;
      begin
         if this.Hit_Surface then
            pic_id := map(Where.y, Where.x);
            if pic_id in 0 | No_Picture then
               return;
            end if;
            if (pic_id / 2) not in this.Pictures'Range then
               return;
            end if;
            this.Sceneries.Append((
               Layer => ml_Surface, 
               West_North | Location => Where,
               Picture_Id => pic_id));
         else
            this.Draw_Grid(ml_Surface, Where);
         end if;
      end Draw_Surface_Grid;
   begin
      if this.Visibles(ml_Surface) then
         this.Iterate_Layer(map, Corners, Draw_Surface_Grid'Access);
      end if;
   end Paint_Surface;


   procedure Paint_Buildings (
      this : in out Stage_Type;
      Corners : View_Corners_Type
      )
   is
      map : Layer_Access := this.Layers(ml_Building);
      building_set : Point_Sets.Set;
      procedure Draw_Building_Grid (Where : Point_Type)
      is
         b  : Scenery_Type;
      begin
         b.Location := Get_Building_Location(this, Where);
         if b.Location = (0, 0) then
            return;
         end if;
         b.Picture_Id := map(b.Location.y, b.Location.x);
         if b.Picture_Id in 0 | No_Picture then
            return;
         end if;
         if (b.Picture_Id / 2) not in this.Pictures'Range then
            return;
         end if;
         if building_set.Contains(b.Location) then
            return;
         end if;
         building_set.Include(b.Location);
         b.Layer := ml_Building;
         b.West_North := Where;
         this.Sceneries.Append(b);
      end Draw_Building_Grid;

      procedure Draw_Hung_Item (Where : Point_Type)
      is
      begin
         this.Draw_Grid(ml_Building, Where);
      end Draw_Hung_Item;

   begin
      if this.Visibles(ml_Building) then
         if not this.Hit_Surface then
            this.Iterate_Layer(map, Corners, Draw_Building_Grid'Access);
         else
            this.Iterate_Layer(map, Corners, Draw_Hung_Item'Access);
         end if;
      end if;
   end Paint_Buildings;

   procedure Paint_Stories (
      this : in out Stage_Type;
      Corners : View_Corners_Type
      )
   is
      map : Layer_Access := this.Layers(ml_Story);

      procedure Draw_Story_Grid (Where : Point_Type)
      is
         id : Uint16_t := map(Where.y, Where.x);
      begin
         if id not in this.Stories'Range then
            return;
         end if;
         declare
            story : Story_Type renames this.Stories(id);
         begin
--            if story.Visible = No then
--               return;
--            end if;
            id := story.Movie_Frame.Current;
            if id in 0 | No_Picture then
               return;
            end if;
            if (id / 2) not in this.Pictures'Range then
               return;
            end if;
            this.Sceneries.Append((
               Layer => ml_Story, 
               West_North | Location => Where,
               Picture_Id => id));
         end;
      end Draw_Story_Grid;
   begin
      if this.Visibles(ml_Story) then
         this.Iterate_Layer(map, Corners, Draw_Story_Grid'Access);
      end if;
   end Paint_Stories;

   procedure Paint_Sprites (this : in out Stage_Type)
   is
   begin
      for h of this.Heroes.all loop
         declare
            s : Scenery_Type := (
               Layer => ml_Sprite,
               West_North | Location => h.Position, 
               Picture_Id => this.Get(ml_Sprite, h.Position));
         begin
            this.Sceneries.Append(s);
         end;
      end loop;
   end Paint_Sprites;

   procedure Paint_Scenery_Grids(
      this : in out Stage_Type;
      S    : Scenery_Type
      )
   is
      v, c : Point_Type;
   begin
      if s.West_North = s.Location then
         return;
      end if;
      for y in S.West_North.y .. S.Location.y loop
         for x in S.West_North.x .. S.Location.x loop
            if In_Bound(this.Layers(s.Layer), (x, y)) then
               this.Map_To_View((x, y), v);
               this.View_To_Canvas(v, c);
               this.Canvas.Draw_Picture(this.Pictures(1), c);
            end if;
         end loop;
      end loop;
   end Paint_Scenery_Grids;

   procedure Paint_Sceneries (this : in out Stage_Type)
   is
   begin
      Scenery_Sorting.Sort(this.Sceneries);
      -- Trace_Log("Draw_Sceneries : n = " & this.Sceneries.Length'Img);
      for scenery of reverse this.Sceneries loop
         declare
            picture_id : Uint16_t := scenery.Picture_Id;
            pictures   : Pictures_Pointer := this.Pictures;
            picture    : Picture_Type;
            v, c       : Point_Type;
         begin
            if picture_id mod 2 = 1 then
               for g of this.Movies loop
                  if Is_Same_Location(g, scenery.Layer, scenery.Location) then
                     picture_id := (g.Movie.First + Uint16_t(g.Movie.Index)) * 2;
                     pictures := g.Movie.Pictures;
                     exit;
                  end if;
               end loop;
            end if;
            picture_id := picture_id / 2;
            this.Map_To_View(scenery.Location, v);
            this.View_To_Canvas(v, c);
            picture := pictures(picture_id);
            this.Canvas.Draw_Picture(picture, c);
            if Show_Building_Grids then
               Paint_Scenery_Grids(this, scenery);
            end if;
         end;
      end loop;
   end Paint_Sceneries;

   procedure Add_Control (
      this    : in out Stage_Type;
      Control : Controls.Control_Access
      )
   is
   begin
      this.Components.Append(Control);
   end Add_Control;

   procedure Remove_Control (
      this    : in out Stage_Type;
      Control : Controls.Control_Access
      )
   is
      i : Controls.Control_Lists.Cursor := this.Components.Find(Control);
      c : Controls.Control_Access := Control;
   begin
      if Controls.Control_Lists.Has_Element(i) then
         this.Components.Delete(i);
         if c.Managed then
            Controls.Delete(c);
         end if;
      end if;
   end Remove_Control;

   function Get_Fog (this : in out Stage_Type) return Controls.Fog_Access
   is
   begin
      return this.Fog'Unchecked_Access;
   end Get_Fog;

   procedure Paint_Components (
      this : in out Stage_Type
      )
   is
   begin
      Controls.Paint_Controls(this.Components, this.Canvas);
   end Paint_Components;

   procedure Paint (this : in out Stage_Type; Region : Region_Type)
   is
      -- 清除背景
      procedure Erase_Background
      is
         vr : SDL.Video.Rect_t;
         scroll : Point_Type := (Region.Top_Left - this.Sight_View.Top_Left);
      begin
         vr.x := scroll.x * this.Grid_Size.x;
         vr.y := scroll.y * this.Grid_Size.y;
         vr.w := Uint16_t(this.Grid_Size.x * Width(Region));
         vr.h := Uint16_t(this.Grid_Size.y * Height(Region));
         SDL.Video.Fill_Rect(this.Canvas.As_Surface, vr, 16#FF000000#);
      end Erase_Background;

      procedure Paint_Layers
      is
         R1 : Region_Type := Region;
         M1 : View_Corners_Type;
         R2 : Region_Type := Region;
         Extend_Size : constant Point_Type := (36, 36);
         M2 : View_Corners_Type;
      begin
         this.Sceneries.Clear;
         R1.Top_Left.x := R1.Top_Left.x - this.Grid_Size.x;
         R1.Bottom_Right.y := R1.Bottom_Right.y + this.Grid_Size.y;
         this.View_Region_To_Map_Region(R1, M1);
         Stage_Class(this).Paint_Background(M1);
         R2.Top_Left.x := R2.Top_Left.x - Extend_Size.x;
         R2.Bottom_Right := R2.Bottom_Right + Extend_Size;
         this.View_Region_To_Map_Region(R2, M2);
         Stage_Class(this).Paint_Surface(if this.Hit_Surface then M1 else M2);
         if not this.Hit_Surface then
            Stage_Class(this).Paint_Buildings(M2);
         end if;
         Stage_Class(this).Paint_Stories(M2);
--         Stage_Class(this).Paint_Sprites;
         Stage_Class(this).Paint_Sceneries;
         if this.Hit_Surface then
            Stage_Class(this).Paint_Buildings(M2);
         end if;
         Stage_Class(this).Paint_Components;
      end Paint_Layers;
   begin
      if this.Canvas.As_Surface = null then
         this.Canvas.Bind;
      end if;
      Erase_Background;
      Paint_Layers;
   end Paint;

   procedure Paint (this : in out Stage_Type)
   is
   begin
      this.Paint (this.Sight_View);
   end Paint;

   -- 滚动视觉地图
   procedure Scroll_View_By (
      this   : in out Stage_Type;
      Offset : Point_Type
      )
   is
   begin
      Add(this.Sight_View.Top_Left, Offset);
      Add(this.Sight_View.Bottom_Right, Offset);
      this.Canvas.Invalidate;
   end Scroll_View_By;

   -- 滚动地图
   procedure Scroll_Map_By (
      this   : in out Stage_Type;
      Offset : Point_Type
      )
   is
   begin
      this.Scroll_View_By((Offset.x - Offset.y, Offset.y + Offset.x));
   end Scroll_Map_By;

   -- 滚动地图使指定地图位置成为画布中心点
   procedure Scroll_To_Canvas_Center (
      this : in out Stage_Type;
      M    : Point_Type
      )
   is
      v : Point_Type;
      tl : Point_Type;
      sight_view : Region_Type renames this.Sight_View;
      canvas_size : Point_Type;
   begin
      this.Map_To_View(M, v);
      canvas_size := sight_view.Bottom_Right - sight_view.Top_Left;
      tl := (v.x - canvas_size.x / 2, v.y - canvas_size.y / 2);
      sight_view := (Top_Left => tl, Bottom_Right => tl + canvas_size);
      this.Canvas.Invalidate;
   end Scroll_To_Canvas_Center;

   function Round_Div (Left, Right : Int16_t) return Int16_t
   is
   begin
      return (Left + Right - 1) / Right;
   end Round_Div;

   function Round_Div (Left, Right : Point_Type) return Point_Type
   is
   begin
      return (Round_Div(Left.x, Right.x), Round_Div(Left.y, Right.y));
   end Round_Div;

   -- 初始化
   procedure Setup (
      this      : in out Stage_Type;
      Map_Size  : Point_Type;
      Grid_Size : Point_Type := (x => 18, y => 9);
      Pictures  : Pictures_Pointer;
      Scene     : access Scene_Type := null
      )
   is
      w : Int16_t := Int16_t(Renders.Screen.W);
      h : Int16_t := Int16_t(Renders.Screen.H);
      sight_view : Region_Type renames this.Sight_View;
      sight_view_size : Point_Type := Round_Div((w, h), Grid_Size);
   begin
      this.Map_Size := Map_Size;
      this.View_Size := (x => Map_Size.x * 2, y => Map_Size.y * 2);
      this.Pictures := Pictures;
      this.Grid_Size := Grid_Size;
      this.Origin := (Map_Size.x, 0);
      sight_view.Top_left := this.Origin - (sight_view_size.x / 2, 0);
      sight_view.Bottom_Right := sight_view.Top_Left + sight_view_size;
      this.Scene := Scene;
      Load_Map(Stage_Type'Class(this));
      Load_Heroes(Stage_Type'Class(this));
   end Setup;

   function Get_Map_Region (
      this : Stage_Type
      ) return Region_Type
   is
   begin
      return ((0, 0), this.Map_Size - (1, 1));
   end Get_Map_Region;

   function Find_Scene_At (
      this  : in out Stage_Type;
      Door  : Point_Type;
      Scene : out Uint16_t
      ) return Boolean
   is
   begin
      Scene := No_Scene;
      return False;
   end Find_Scene_At;

   function Has_Door_At (
      this : in out Stage_Type;
      M    : Point_Type
      ) return Boolean
   is
   begin
      return this.Scene /= null and then this.Scene.Door = M;
   end Has_Door_At;

   function Has_Exit_At (
      this : in out Stage_Type;
      M    : Point_Type
      ) return Boolean
   is
   begin
      if this.Scene = null then
         return False;
      end if;
      if not Enter_From_World(this.Scene.all) then
         -- 二级场景
         return this.Scene.Child_Scene_Entry = M;
      else
         declare
            e : Coordinates_Type renames this.Scene.Exits;
         begin
            return (for some i in 1 .. e.Count => M = (e.X(i), e.Y(i)));
         end;
      end if;
   end Has_Exit_At;

   -- 主角
   function Myself (
      this : in out Stage_Type
      ) return access Roles.Role_Type'Class
   is
   begin
      return this.Hero;
   end Myself;

   -- 根据世界时钟移动英雄
   procedure Move_Heroes (
      this  : in out Stage_Type;
      Timer : Hash_Type;
      Count : Natural
      )
   is
      use type Legend.Roles.Roles_Access;
   begin
      if this.Heroes /= null then
         for who of this.Heroes.all loop
            who.On_Timer(Timer, Count);
         end loop;
      end if;
   end Move_Heroes;


   procedure Say (
      this     : in out Stage_Type; 
      Message  : String; 
      Linefeed : String := "*";
      Icon     : Uint16_t := 0
      )
   is
      use type Interfaces.C.int;
      pragma Warnings(Off);
      d : Legend.Dialogs.Dialog_Type;
   begin
      d.Prompt(Message);
      d.Linefeed(Linefeed);
      if Icon in Resources.Head_Images'Range then
         d.Icon(Resources.Head_Images(Icon));
      end if;
      d.Run;
   end Say;

   function Confirm (
      this : in out Stage_Type;
      Message : String
      ) return Boolean 
   is
      use type Interfaces.C.int;
      pragma Warnings(Off);
      d : Legend.Dialogs.Dialog_Type;
      r : Boolean;
   begin
      d.Prompt(Message & "(Y/N)");
      d.Add_Expect(SDL.Keysym.K_Y);
      d.Add_Expect(SDL.Keysym.K_N);
      d.Run;
      r := d.Dialog_Result in SDL.Keysym.K_Y;
      return r;
   end Confirm;

   function Select_Team_Member (
      this            : in out Stage_Type;
      Skill           : Skill_Type := s_Attack;
      Min_Skill_Value : Int16_t := -1 
      ) return Uint16_t
   is
      menu : Menus.Menubar_Pointer := Menus.Create(this'Unchecked_Access);
      mi : Menus.Menuitem_Pointer;
      result : Uint16_t := No_Hero;
   begin
      menu.Set_Position((100, 40));
      for id of All_World.Leader.Team loop
         if id /= No_Hero then
            declare
               h : Hero_Type renames All_World.Heroes(id);
               v : Int16_t renames h.Skills(Skill);
            begin
               if v > Min_Skill_Value then
                  mi := new Menus.Menuitem_Type;
                  case Skill is
                     when s_Cure =>
                        mi.Caption(To_UTF8_Name(h.Name) & " " & StrRes.Hero_State.Cure & v'Img);
                     when s_Detoxify =>
                        mi.Caption(To_UTF8_Name(h.Name) & " " & StrRes.Hero_State.Detoxify & v'Img);
                     when others =>
                        mi.Caption(To_UTF8_Name(h.Name));
                  end case;
                  mi.Id(Natural(id));
                  menu.Add_Item(mi);
               end if;
            end;
         end if;
      end loop;
      menu.Run;
      if menu.Id >= 0 then
         result := Uint16_t(menu.Id);
      end if;
      Menus.Delete(menu);
      return result;
   end Select_Team_Member;

   function Select_Team_Member (
      this       : in out Stage_Type;
      Attr_Name  : UTF8_String;
      Attr_Value : not null access function (Who : Hero_Type) return UTF8_String 
      ) return Uint16_t
   is
      menu : Menus.Menubar_Pointer := Menus.Create(this'Unchecked_Access);
      mi : Menus.Menuitem_Pointer;
      result : Uint16_t := No_Hero;
   begin
      menu.Set_Position((100, 40));
      for id of All_World.Leader.Team loop
         if id /= No_Hero then
            declare
               h : Hero_Type renames All_World.Heroes(id);
               v : UTF8_String := Attr_Value(h);
            begin
               mi := new Menus.Menuitem_Type;
               mi.Caption(To_UTF8_Name(h.Name) & " " & Attr_Name & v);
               mi.Id(Natural(id));
               menu.Add_Item(mi);
            end;
         end if;
      end loop;
      menu.Run;
      if menu.Id >= 0 then
         result := Uint16_t(menu.Id);
      end if;
      Menus.Delete(menu);
      return result;
   end Select_Team_Member;

   procedure Select_War_Team (
      this : in out Stage_Type;
      War  : in out War_Define_Type
      )
   is
      use type Menus.Menuitem_Pointer;
      menu : Menus.Menubar_Pointer := Menus.Create(Stages.Current_Stage, True);
      mi : Menus.Menuitem_Pointer;
      hs : Uint16_Lists.List;
   begin
      this.Say(StrRes.Please_Select_War_Team);
      menu.Set_Position((100, 40));
      for h of War.Required_Heroes loop
         exit when h = No_Hero;
         hs.Append(h);
         mi := new Menus.Menuitem_Type;
         mi.Id(Natural(h));
         mi.Caption(To_UTF8_Name(All_World.Heroes(h).Name));
         mi.Checkable(False);
         mi.Checked(True);
         menu.Add_Item(mi);
      end loop;
      for h of All_World.Leader.Team loop
         if h /= No_Hero and then not hs.Contains(h) then
            hs.Append(h);
            mi := new Menus.Menuitem_Type;
            mi.Id(Natural(h));
            mi.Caption(To_UTF8_Name(All_World.Heroes(h).Name));
            mi.Checkable(True);
            menu.Add_Item(mi);
         end if;
      end loop;
      mi := new Menus.Menuitem_Type;
      mi.Caption(StrRes.Select_Hero_Menus.End_Select);
      menu.Add_Item(mi);
      menu.Run;
      declare
         i : Positive := War.Heroes.Id'First;
         procedure Add_To_War (Menuitem : Menus.Menuitem_Pointer)
         is
         begin
            if i /= War.Heroes.Id'Last and then Menuitem.Checked then
               War.Heroes.Id(i) := Uint16_t(Menuitem.Id);
               i := i + 1;
            end if;
         end Add_To_War;
      begin
         War.Heroes.Id := (others => No_Hero);
         menu.Iterate(Add_To_War'Access);
      end;
      Menus.Delete(menu);
   end Select_War_Team;

   procedure Iterate_Heroes (
      this : in out Stage_Type;
      Break : not null access function (Who : Roles.Role_Pointer) return Boolean
      )
   is
   begin
      for who of this.Heroes.all loop
         exit when Break(who);
      end loop;
   end Iterate_Heroes;

   function Find_Hero_At (
      this : Stage_Type;
      Where : Point_Type
      ) return Roles.Role_Pointer
   is
   begin
      for who of this.Heroes.all loop
         if who.Position = Where then
            return who;
         end if;
      end loop;
      return null;
   end Find_Hero_At;

   procedure Play_Story_Movie (
      this : in out Stage_Type; 
      Movie : Story_Movie_Type 
      )
   is
      use Ada.Calendar;
      m : Movie_Type := (
         Pictures => this.Pictures,
         Total => Natural(Movie.Last - Movie.First) / 2 + 1,
         First => Movie.First / 2,
         Index => 1,
         Interval => Interval(6.0),
         others => <>);
      life : Time := Clock + Length(m);
      function Over return Boolean
      is
      begin
         return Clock > life;
      end Over;
   begin
      if Movie.Story_Id = No_Story then
         this.Hero.Play(m, Count => 1);
         this.Switch_To_Movie_Mode(Over'Access);
         this.Hero.Stand;
      else
         declare
            story : Story_Type renames this.Stories(Movie.Story_Id);
            old   : Story_Type := story;
         begin
            story.Movie_Frame := (First => Movie.First, Last => Movie.Last, Current => Movie.First);
            story.Visible := YES;
            this.Switch_To_Movie_Mode(Over'Access);
            story := old;
         end;
      end if;
   end Play_Story_Movie;

   procedure Play_Story_Movies (
      this : in out Stage_Type; 
      Movies : Story_Movie_Array_Type
      )
   is
      use Ada.Calendar;
      d : Duration := 0.0;
      frame_dur : Duration := Interval(6.0);
      life : Time;
      function Over return Boolean
      is
      begin
         return Clock > life;
      end Over;
   begin
      for m of Movies loop
         declare
            story : Story_Type renames this.Stories(m.Story_Id);
         begin
            story.Movie_Frame := (First => m.First, Last => m.Last, Current => m.First);
            story.Visible := YES;
            d := d + Duration((m.Last - m.First) / 2 + 1) * frame_dur;
         end;
      end loop;
      life := Clock + d;
      this.Switch_To_Movie_Mode(Over'Access);
   end Play_Story_Movies;


   procedure Use_Drug_Item (this : in out Stage_Type; Item : in out Item_Type)
   is
      hero_id : Uint16_t;
   begin
      this.Say(StrRes.Who_Will_Apply & To_UTF8_Name(Item.Name));
      hero_id := this.Select_Team_Member;
      if hero_id = No_Hero then
         return;
      end if;
      declare
         Hero : Hero_Type renames All_World.Heroes(hero_id);
      begin
         Apply_Item_Bonus(Hero, Item);
      end;
   end Use_Drug_Item;

   procedure Use_Equip_Item (this : in out Stage_Type; Item : in out Item_Type)
   is
      hero_id : Uint16_t;
   begin
      this.Say(StrRes.Who_Will_Equip & To_UTF8_Name(Item.Name));
      hero_id := this.Select_Team_Member;
      if hero_id = No_Hero then
         return;
      end if;
      declare
         Hero : Hero_Type renames All_World.Heroes(hero_id);
      begin
         if not Match_Require(Hero, Item) then
            this.Say(To_UTF8_Name(Hero.Name) & StrRes.Not_Match_Study_Require);
            return;
         end if;
         if Item.Owner /= No_Hero then
            if not this.Confirm(StrRes.Confirm_Change_Equip_Owner) then
               return;
            else
               Unequip_Item(All_World.Heroes(Item.Owner), Item.Equip);
            end if;
         end if;
         Equip_Item(Hero, Item);
      end;
   end Use_Equip_Item;

   procedure Use_Study_Book (this : in out Stage_Type; Book : in out Item_Type)
   is
      procedure Study (Hero : in out Hero_Type)
      is
      begin
         if Book.Owner = Hero.Id then
            return;
         end if;
         if not Match_Require(Hero, Book) then
            this.Say(To_UTF8_Name(Hero.Name) & StrRes.Not_Match_Study_Require);
            return;
         end if;
         if Book.Owner /= No_Hero then
            if not this.Confirm(StrRes.Confirm_Change_Book_Owner) then
               return;
            else
               Unequip_Book(All_World.Heroes(Book.Owner));
            end if;
         end if;
         if (Book.Id in 78 | 93) and then Hero.Sex /= Neutral then
            if not this.Confirm(StrRes.Confirm_Change_Sex) then
               return;
            else
               Hero.Sex := Neutral;
            end if;
         end if;
         Equip_Book(Hero, Book);
         this.Canvas.Invalidate;
      end Study;

      hero_id : Uint16_t;
   begin
      this.Say(StrRes.Who_Will_Study & To_UTF8_Name(Book.Name));
      hero_id := this.Select_Team_Member;
      if hero_id = No_Hero then
         return;
      end if;
      declare
         Hero : Hero_Type renames All_World.Heroes(hero_id);
      begin
         Study(Hero);
      end;
   end Use_Study_Book;

   procedure On_Mouse_Down (
      this : in out Stage_Type;
      Message : SDL.Events.Mouse_Button_Event_t;
      Cancel_bubble : in out Boolean
      )
   is
      c : Point_Type := (Int16_t(Message.X), Int16_t(Message.Y));
      v, m, b : Point_Type;
   begin
      if (Message.Button and 2) /= 2 then
         return;
      end if;
      v.x := c.x / this.Grid_Size.x + this.Sight_View.Top_Left.x;
      v.y := c.y / this.Grid_Size.y + this.Sight_View.Top_Left.y;
      this.View_To_Map(v, m);
      this.Hero.Clear_Route;
      if not this.Hit_Surface then
         b := this.Get_Building_Location(m);
         if b /= (0, 0) and b /= m then
            for scene_id of this.Scenes loop
               declare
                  scene : Scene_Type renames All_World.Scenes(scene_id);
                  door  : Point_Type renames scene.Outer_Entries(1);
               begin
                  if this.Get_Building_Location(door) = b then
                     Trace_Log("goto " & To_UTF8_Name(scene.Name));
                     m := door;
                     exit;
                  end if;
               end;
            end loop;
         end if;
      end if;
      this.Hero.Search_Route(m);
      this.Hero.Start_Walk;
   end On_Mouse_Down;

   procedure On_Mouse_Up (
      this : in out Stage_Type;
      Message : SDL.Events.Mouse_Button_Event_t;
      Cancel_Bubble : in out Boolean
      )
   is
   begin
      if (Message.Button and 2) = 2 then
         this.Hero.Stop_Walk;
      end if;
   end On_Mouse_Up;

   procedure On_Key_Down (
      this          : in out Stage_Type;
      Message       : SDL.Events.Keyboard_Event_t;
      Cancel_Bubble : in out Boolean
      )
   is
      procedure Change_Face_To (F : Face_Type)
      is
         pragma Inline(Change_Face_To);
      begin
         this.Myself.Clear_Route;
         this.Myself.Face(F, Walk => True);
      end Change_Face_To;
   begin
      case Message.Keysym.Sym is
         when SDL.Keysym.K_Up    => Change_Face_To(North);
         when SDL.Keysym.K_Down  => Change_Face_To(South);
         when SDL.Keysym.K_Left  => Change_Face_To(West);
         when SDL.Keysym.K_Right => Change_Face_To(East);
         when others             => null;
         --    cancel_bubble := false;
      end case;
   end On_Key_Down;


   procedure On_Key_Up (
      this          : in out Stage_Type;
      Message       : SDL.Events.Keyboard_Event_t;
      Cancel_Bubble : in out Boolean
      )
   is
   begin
      case Message.Keysym.Sym is
         when SDL.Keysym.K_Tab =>
            Renders.Toggle_Fullscreen;
            this.Canvas.Invalidate;
         when SDL.Keysym.K_Escape =>
            this.Popup_Menu;
         when SDL.Keysym.K_C =>
            if this.Sprite_Layer = ml_Building then
               declare
                  b : Point_Type := this.Get_Building_Location(this.Hero.Next_Position);
               begin
                  if b /= (0, 0) and then this.Get(ml_Building, b) /= 0 then
                     this.Set_Building_At(b, 0);
                     this.Canvas.Invalidate;
                  end if;
               end;
            else
               this.Set(this.Sprite_Layer, this.Hero.Next_Position, 0);
            end if;
         when SDL.Keysym.K_T =>
            Story_Engine.Toggle_Debug_Mode;
         when SDL.Keysym.K_W =>
            Water_Obstacle := not Water_Obstacle;
         when SDL.Keysym.K_P =>
            this.Hero.Emit(this.Canvas.Get_Performance.Average'Img);
            Trace_Log("渲染性能: " & this.Canvas.Get_Performance.Average'Img);
            Trace_Log("当前视野景物数: " & this.Sceneries.Length'Img);
         when SDL.Keysym.K_Y =>
            declare
               loc : Point_Type;
               inn : Uint16_t := Story_Engine.Where_Is_The_Shop(loc);
            begin
               if inn /= No_Scene then
                  Trace_Log(To_UTF8_Name(All_World.Scenes(inn).Name) & Traces.Image(loc));
               end if;
            end;
         when others =>
            this.Myself.Stop_Walk;
            --    cancel_bubble := False;
      end case;
   end On_Key_Up;

   procedure On_Timer (
      this          : in out Stage_Type;
      Timer         : Hash_Type;
      Count         : Natural;
      Cancel_Bubble : in out Boolean
      )
   is
      subtype Base_Class is Interactives.Interactive_Type;
      n : Natural := 0;
   begin
      Base_Class(this).On_Timer(Timer, Count, Cancel_Bubble);
      for g of this.Movies loop
         if g.Movie.Timer = Timer then
            Next_Frame(g.Movie);
            n := n + 1;
         end if;
      end loop;
      if n > 0 then
         this.Canvas.Invalidate;
      end if;
      if not Cancel_Bubble then
         Move_Heroes(this, Timer, Count);
         Cancel_Bubble := True;
      end if;
   end On_Timer;

   -- 进入子场景
   procedure Switch_To_Room (
      this : in out Stage_Type;
      Scene : access Scene_Type
      )
   is
      room : Rooms.Room_Access := new Rooms.Room_Type;
      room_name : String := Stdout_UTF8(To_UTF8_Name(Scene.Name));
   begin
      Trace_Log("进入场景: " & room_name & "(" & Scene.Id & ")");
      Stage_Pointer(room).Parent := this'Unrestricted_Access;
      Resources.Load_Room_Pictures(Scene.Id);
      -- setup use canvas properties, so bind must call before setup
      room.Canvas.Bind;
      room.Setup (
         Map_Size  => (x => Room_Width, y => Room_Height),
         Grid_Size => this.Grid_Size,
         Pictures  => Resources.Inner_Images(Scene.Id),
         Scene     => Scene);
      room.Myself.Face(this.Myself.Face);
      room.Myself.Emit(room_name);
      Music.Play_Background_Music(Scene.Enter_Music);
      room.Run;
      Music.Play_Background_Music(Scene.Leave_Music);
      Dispose(Stage_Pointer(room));
   end Switch_To_Room;

   -- 进入战斗场景
   procedure Switch_To_War (
      this : in out Stage_Type;
      War  : War_Define_Type
      )
   is
      dummy : Camp_Type := this.Switch_To_War(War);
   begin
      null;
   end Switch_To_War;

   function Switch_To_War (
      this : in out Stage_Type;
      War  : War_Define_Type
      ) return Camp_Type
   is
      result : Camp_Type;
      field : WarFields.War_Field_Pointer := new Warfields.War_Field_Type;
      war_name : String := To_UTF8_Name(War.Name);
   begin
      Trace_Log("进入战场: " & war_name & "(" & War.Id & ")");
      Stage_Pointer(field).Parent := this'Unrestricted_Access;
      field.Set_Profile(war);
      Resources.Load_War_Pictures(War.Scene);
      field.Canvas.Bind;
      field.Setup(
         Map_Size  => (x => War_Field_Width, y => War_Field_Height),
         Grid_Size => this.Grid_Size,
         Pictures  => Resources.War_Images(War.Scene),
         Scene     => null);
      field.Run;
      result := field.Get_Winner;
      Dispose(Stage_Pointer(field));
      this.Canvas.Invalidate;
      return result;
   end Switch_To_War;

   procedure Run (this : in out Stage_Type)
   is
   begin
      Stage_Stack.Append(this'Unrestricted_Access);
      Interactives.Interactive_Type(this).Run;
      Stage_Stack.Delete_Last;
   end Run;

   procedure Initialize (this : in out Stage_Type)
   is
   begin
      this.Scene := null;
      this.Layers := (others => null);
      this.Visibles := (others => True);
      this.Heroes := null;
      this.Hero := null;
      this.Cur_Story_Id := No_Story;
      this.Add_Control(this.Fog'Unchecked_Access);
      --      this.Menubar := null;
   end Initialize;

   procedure Finalize (this : in out Stage_Type)
   is
   begin
      Trace_Log("destroying stage");
      Trace_Log("destroying controls");
      for c_ref of this.Components loop
         declare
            c : Controls.Control_Access := c_ref;
         begin
            if c.Managed then
               Controls.Delete(c);
            end if;
         end;
      end loop;
      this.Components.Clear;
      this.Movies.Clear;
--      Menus.Delete(this.Menubar);
      for cell of this.Layers(this.Sprite_Layer).all loop
         Set_Movie_Flag(cell, False);
      end loop;
      Trace_Log("destroying heroes");
      Roles.Dispose(this.Heroes);
      -- Trace_Log ("destroyed stage");
   end Finalize;

   function Stories (
      this : Stage_Type
      ) return Stories_Pointer
   is
   begin
      if this.Scene = null then
         return null;
      else
         return All_Scene_Stories(this.Scene.Id);
      end if;
   end Stories;

   function Get_Scene_Id (
      this : Stage_Type
      ) return Uint16_t
   is
   begin
      return (if this.Scene = null then No_Scene else this.Scene.Id);
   end Get_Scene_Id;

   function Get_Story_Id (
      this : Stage_Type
      ) return Uint16_t
   is
   begin
      return this.Cur_Story_Id;
   end Get_Story_Id;

   function Current_Story (
      this : in out Stage_Type
      ) return access Story_Type
   is
      stories : Stories_Pointer := this.Stories;
   begin
      if stories /= null then
         if this.Cur_Story_Id /= No_Story then
            return stories(this.Cur_Story_Id)'Access;
         end if;
      end if;
      return null;
   end Current_Story;

   procedure Check_Story (
      this  : in out Stage_Type;
      Where : Point_Type;
      Cause : Script_Cause_Type
      )
   is
      id : Uint16_t;
   begin
      id := this.Get(ml_Story, Where);
      if id /= No_Story and then id in this.Stories'Range then
         declare
            s : Story_Type renames this.Stories(id);
            script : Uint16_t := s.Scripts(Cause);
         begin
            this.Cur_Story_Id := id;
            if script /= No_Script then
               this.Hero.Stop_Walk;
               Story_Engine.Invoke_Story(script);
            end if;
         end;
      end if;
   end Check_Story;

   procedure On_Stage_Menu_Cure (this : in out Stage_Type)
   is
      function Get_HP (Who : Hero_Type) return UTF8_String 
      is
      begin
         return Traces.Image(Who.HP);
      end Get_HP;
   begin
      this.Hero.Emit(StrRes.Who_Will_Cure);
      this.Canvas.Repaint;
      declare
         doctor, patient : Uint16_t;
         bonus : Int16_t;
      begin
         doctor := this.Select_Team_Member(s_Cure, 20);
         if doctor = No_Hero then
            return;
         end if;
         this.Hero.Emit(StrRes.Who_Need_Cure);
         this.Canvas.Repaint;
         patient := this.Select_Team_Member(
            StrRes.Hero_State.HP, 
            Get_HP'Access);
         if patient = No_Hero then
            return;
         end if;
         Apply_Cure(
            All_World.Heroes(doctor), 
            All_World.Heroes(patient),
            bonus);
      end;
   end On_Stage_Menu_Cure;

   procedure On_Stage_Menu_Detoxify (this : in out Stage_Type)
   is
      function Get_Weakness (Who : Hero_Type) return UTF8_String 
      is
      begin
         return Who.Weakness'Img;
      end Get_Weakness;
   begin
      this.Hero.Emit(StrRes.Who_Will_Detoxify);
      this.Canvas.Repaint;
      declare
         doctor, patient : Uint16_t;
         bonus : Int16_t;
      begin
         doctor := this.Select_Team_Member(s_Detoxify, 20);
         if doctor = No_Hero then
            return;
         end if;
         this.Hero.Emit(StrRes.Who_Need_Detoxify);
         this.Canvas.Repaint;
         patient := this.Select_Team_Member(
            StrRes.Hero_State.Weakness, 
            Get_Weakness'Access);
         if patient = No_Hero then
            return;
         end if;
         Apply_Detoxify(
            All_World.Heroes(doctor), 
            All_World.Heroes(patient),
            bonus);
      end;
   end On_Stage_Menu_Detoxify;

   procedure On_Stage_Menu_State (this : in out Stage_Type)
   is
      d : Hero_State_Dialog.Hero_State_Dialog_Type;
   begin
      d.Run;
   end On_Stage_Menu_State;


   function Current_Stage return Stage_Pointer
   is
   begin
      return Stage_Stack.Last_Element;
   end Current_Stage;

   procedure Close_All_Stage 
   is
   begin
      for stage of Stage_Stack loop
         stage.Close;
      end loop;
   end Close_All_Stage;

   procedure Popup_Menu (this : in out Stage_Type'Class)
   is
      use Menus;
      mb : Menus.Menubar_Pointer := null;
   begin
      this.Hero.Stop_Walk;
      this.On_Popup_Menu(mb);
      if mb /= null then
         mb.Run;
         this.On_Command(mb.Id);
         Menus.Delete(mb);
      end if;
   end Popup_Menu;

end Legend.Stages;
